home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
dbase
/
lib19.zip
/
ARRAY.PRG
next >
Wrap
Text File
|
1992-07-07
|
31KB
|
834 lines
*-------------------------------------------------------------------------------
*-- Program...: ARRAY.PRG
*-- Programmer: Ken Mayer (KENMAYER)
*-- Date......: 07/07/1992
*-- Notes.....: These routines deal with filling arrays, sorting arrays,
*-- and so on ... See README.TXT for details on using this file.
*-------------------------------------------------------------------------------
FUNCTION Afill
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (JPARSONS)
*-- Date........: 04/22/1992
*-- Notes.......: Creates if needed, and fills a row or column of, an array,
*-- with sequential numeric elements starting with nFirst,
*-- increasing by nStep.
*-- Useful for testing routines that require an array ...
*-- Written for.: dBASE IV, 1.1
*-- Rev. History: Original function 03/01/1992.
*-- 04/22/92 - Jay Parsons - calling syntax changed
*-- Calls.......: AMASK() Functon in ARRAY.PRG
*-- Called by...: Any
*-- Usage.......: AFill("<cArrayskel>",<nCount>,<nFirstVal>,<nStep>)
*-- Example.....: lX = AFill("aTest",20,1,10)
*-- Returns.....: .T. (and an array filled with values as in "notes" above)
*-- Parameters..: cArrayskel = Name of array and optional row/column info
*-- nCount = number of elements to fill
*-- nFirstVal = starting value in array
*-- nStep = number to increment by
*-- Side effects: Creates as public, if needed, and fills array. Will destroy
*-- existing array of the same name if its dimensions are
*-- inadequate for the data to be filled in.
*-------------------------------------------------------------------------------
parameters cArrayskel, nCount, nFirstval, nStep
private nAt, cArray, cMask, cElem, nRows, nCols, nFill
cArray = cArrayskel
if "[" $ cArray
cArray = left( cArray, at( "[", cArray ) - 1 )
endif
cArray = trim( ltrim( cArray ) )
cMask = Amask( cArrayskel, "nAt" )
if at( ",", cMask ) > 0 .and. val( substr( cMask, at( ",", cMask ) + 1 ) ) = 0
nRows = val( substr( cMask, at( "[", cMask ) + 1 ) )
nCols = nCount
else
nRows = nCount
nCols = val( substr( cMask, at( ",", cMask ) + 1 ) )
endif
nAt = nCount
cElem = cArray + cMask
if type( cElem ) = "U"
release &cArray
public &cArray
if nCols > 0
declare &cArray[ nRows, nCols ]
else
declare &cArray[ nRows ]
endif
endif
nFill = nFirstval
nAt = 0
do while nAt < nCount
nAt = nAt + 1
cElem = cArray + cMask
store nFill to &cElem
nFill = nFill + nStep
enddo
RETURN .T.
*-- EoF: Afill()
FUNCTION Amask
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (Jparsons)
*-- Date........: 04/21/1992
*-- Notes.......: Returns a "mask" specifying the desired row or column of
*-- an array.
*-- Written for.: dBASE IV
*-- Rev. History: None
*-- Calls : None
*-- Called by...: Any
*-- Usage.......: Amask( <cArrayskel>, <cVar> )
*-- Example.....: ? Amask( "Myarray [ , 1 ]", "nAt" )
*-- Returns : a character value including a passed character string,
*-- which may be used by the calling function to locate array
*-- elements
*-- Parameters..: cArrayskel, a character string including the name of the
*-- array and, if the row or column to be used is not the
*-- first row (or only row if array is one-dimensional),
*-- a bracketed expression with a number indicating the row,
*- or column if the number is preceded by a comma, to be used.
*-- cVar, name of the memvar to be used by calling function.
*-------------------------------------------------------------------------------
parameters cArrayskel, cVar
private nAt, cWhich, cMask, cV
nAt = at( "[", cArrayskel )
cWhich = "0 ]"
cV = trim( ltrim( cVar ) )
if nAt > 0
cWhich = substr( cArrayskel, nAt + 1 )
else
cWhich = "1 ]"
endif
if .not. "," $ cArrayskel
cMask = "[ " + cV + " ]"
else
if val( cWhich ) > 0
cMask = "["+ ltrim( str( val( cWhich ) ) ) + "," + cV + "]"
else
cWhich = substr( cWhich, at( ",", cWhich ) + 1 )
cMask = "[" + cV+ ","+ ltrim( str( val( cWhich ) ) ) + "]"
endif
endif
RETURN cMask
*-- EoF: Amask()
FUNCTION Amean
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (Jparsons)
*-- Date........: 04/13/1992
*-- Notes.......: Mean of non-blank numeric or date values in specified row
*-- : or column of a specified array. If the first value is a
*-- : date, averages only dates. If first value is numeric or
*-- : float, averages only numerics and floats. Exits returning
*-- : .F. if first value is character or logical, if specified
*-- : row or column does not exist or if there are no
*-- : averageable values.
*-- :
*-- Written for.: dBASE IV Version 1.5.
*-- Rev. History: Original function written 1990
*-- : Adapted to Version 1.5 4/13/1992
*-- Calls : AMASK() Function in ARRAY.PRG
*-- Called by...: Any
*-- Usage.......: Amean( <cArrayskel> )
*-- Example.....: ? Amean( "Myarray [ , 1 ]" )
*-- Returns : a numeric, float or date value, the mean or average, or .F.
*-- : If any of the averaged items are floats, the result will be.
*-- Parameters..: cArrayskel, a character string including the name of the
*-- : array and, if the row or column to be averaged is not the
*-- : first row, a bracketed expression with a number indicating
*-- : the row, or column if the number is preceded by a comma,
*-- : to be averaged.
*-------------------------------------------------------------------------------
parameters cArrayskel
private nAt,cArray,cMask,cElem,nTot,nCount,xNext,cOktype
cArray = cArrayskel
if "[" $ cArray
cArray = left( cArray, at( "[", cArray ) - 1 )
endif
cArray = trim( ltrim( cArray ) )
cMask = Amask( cArrayskel, "nAt" )
store 0 to nTot, nCount, nAt
do while .t.
nAt = nAt + 1
cElem = cArray + cMask
xNext = type( cElem )
do case
case xNext = "U"
exit
case nAt = 1
if xNext $ "CL"
exit
else
cOktype = iif( xNext = "D", "D", "NF" )
endif
case .not. xNext $ cOktype
loop
endcase
xNext = &cElem
if isblank( xNext )
loop
endif
if cOktype = "D"
xNext = xNext - {01/01/01}
endif
nTot = nTot + xNext
nCount = nCount + 1
enddo
RETURN iif( nCount = 0, .F., nTot / nCount ;
+ iif( cOktype = "D", {01/01/01}, 0 ) )
*-- EoF: Amean()
FUNCTION Amax
*-------------------------------------------------------------------------------
*-- Programmer..: Jay Parsons (Jparsons)
*-- Date........: 04/13/1992
*-- Notes.......: Finds maximum non-blank numeric, date or character value in
*-- : specified row or column of a specified array. If the first
*-- : value is character or date, considers only that type.
*-- : If first value is numeric or float, considers only numerics
*-- : and floats. Exits returning .F. if first value is logical,
*-- : if specified row or column does not exist or if there are no
* : numeric, date or character values in the row or column.
*-- :
*-- Written for.: dBASE IV Version 1.5.
*-- Rev. History: Original function written 1990
*-- : Adapted to Version 1.5 4/13/1992
*-- Calls : AMASK() Function in ARRAY